home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / mp / fplus.c next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  2.4 KB  |  105 lines
  1.  
  2. /*          Copyright (C) 1994 W. Schelter
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14. for more details.
  15.  
  16. You should have received a copy of the GNU library general public
  17. license along with GCL; see the file COPYING.  If not, write to the
  18. Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19. */
  20.  
  21. /* #include "include.h" */
  22. #include "config.h"
  23. /* #include "cmpinclude.h"   */
  24. /* #include "genpari.h" */
  25. #include "arith.h"
  26. object make_integer();  
  27.  
  28.  
  29. static unsigned long small_pos_int[3]={0x1000003,0x01000003,0};
  30. static unsigned long small_neg_int[3]={0x1000003,0xff000003,0};
  31. static unsigned long s4_neg_int[4]={0x1000004,0xff000004,1,0};
  32.  
  33. object
  34. fplus(a,b)
  35.      int a,b;
  36. { int z ;
  37.   int x;
  38.   if (a >= 0)
  39.    { if (b >= 0)
  40.        { x = a + b;
  41.      if (x == 0) return small_fixnum(0);
  42.      small_pos_int[2]=x;
  43.      return make_integer(small_pos_int);
  44.        }
  45.      else
  46.        { /* b neg */
  47.      x = a + b;
  48.      return make_fixnum(x);
  49.        }}
  50.   else
  51.     { /* a neg */
  52.       if (b >= 0)
  53.     { x = a + b;
  54.       return make_fixnum(x);}
  55.       else
  56.     { /* both neg */
  57.         { unsigned long Xtx,Xty,overflow,Xtres;
  58.           Xtres = addll(-a,-b);
  59.           if (overflow)
  60.         { 
  61.           s4_neg_int[3]=Xtres;
  62.           return make_integer(s4_neg_int);}
  63.           else
  64.         { small_neg_int[2]=Xtres;
  65.           return make_integer(small_neg_int);}
  66.         }}}
  67. }
  68.  
  69.  
  70. object
  71. fminus(a,b)
  72.      int a,b;
  73. { int z ;
  74.   int x;
  75.   if (a >= 0)
  76.    { if (b >= 0)
  77.        { x = a - b;
  78.      return make_fixnum(x);
  79.        }
  80.      else
  81.        { /* b neg */
  82.      x = a - b;
  83.      if (x==0) return small_fixnum(0);
  84.      small_pos_int[2]=x;
  85.      return make_integer(small_pos_int);
  86.        }}
  87.   else
  88.     { /* a neg */
  89.       if (b <= 0)
  90.     { x = a - b;
  91.       return make_fixnum(x);}
  92.       else
  93.     {  /* b positive */
  94.         { unsigned long Xtx,Xty,overflow,Xtres;
  95.           unsigned long t[4];
  96.           Xtres = addll(-a,b);
  97.           if (overflow)
  98.         { s4_neg_int[3]=Xtres;
  99.           return make_integer(s4_neg_int);}
  100.           else
  101.         { small_neg_int[2]=Xtres;
  102.           return make_integer(small_neg_int);}
  103.         }}}
  104. }
  105.